www.gusucode.com > 酷维企业网站CMS管理系统 v2.1.0 > 酷维企业网站CMS管理系统 v2.1.0\code\NewsAdmin\ubb\Include\ReplaceRemoteUrl.asp
<% '☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆ '★ ★ '☆ eWebEditor - eWebSoft在线文本编辑器 ☆ '★ ★ '☆ 版权所有: ☆ '★ ★ '☆ 程序制作: eWeb开发团队 ☆ '★ email:webmaster@webasp.net ★ '☆ QQ:589808 ☆ '★ ★ '☆ 相关网址: [产品介绍]http://www./Product/eWebEditor/ ☆ '★ [支持论坛]http://bbs./ ★ '☆ ☆ '★ 主页地址: http://www./ eWebSoft团队及产品 ★ '☆ http://www.webasp.net/ WEB技术及应用资源网站 ☆ '★ http://bbs.webasp.net/ WEB技术交流论坛 ★ '★ ★ '☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆ %> <% '================================================ '作 用:替换字符串中的远程文件为本地文件并保存远程文件 '参 数: ' sHTML : 要替换的字符串 ' sSavePath : 保存文件的路径 ' sExt : 执行替换的扩展名 '================================================ Function eWebEditor_ReplaceRemoteUrl(sHTML, sSavePath, sExt) Dim s_Content s_Content = sHTML If eWebEditor_IsObjInstalled("Microsoft.XMLHTTP") = False then eWebEditor_ReplaceRemoteUrl = s_Content Exit Function End If If sSavePath = "" Then sSavePath = "/eWebEditor/UploadFile/" If sExt = "" Then sExt = "jpg|gif|bmp|png" Dim re, RemoteFile, RemoteFileurl, SaveFileName, SaveFileType, ranNum Set re = new RegExp re.IgnoreCase = True re.Global = True re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}((\w)+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(" & sExt & ")))" Set RemoteFile = re.Execute(s_Content) For Each RemoteFileurl in RemoteFile SaveFileType = Mid(RemoteFileurl, InstrRev(RemoteFileurl, ".") + 1) Randomize ranNum = Int(900 * Rnd) + 100 SaveFileName = sSavePath & year(now) & month(now) & day(now) & hour(now) & minute(now) & second(now) & ranNum & "." & SaveFileType Call eWebEditor_SaveRemoteFile(SaveFileName, RemoteFileurl) s_Content = Replace(s_Content,RemoteFileurl,SaveFileName) Next eWebEditor_ReplaceRemoteUrl = s_Content End Function '================================================ '作 用:保存远程的文件到本地 '参 数:LocalFileName ------ 本地文件名 ' RemoteFileUrl ------ 远程文件URL '返回值:True ----成功 ' False ----失败 '================================================ Sub eWebEditor_SaveRemoteFile(s_LocalFileName,s_RemoteFileUrl) Dim Ads, Retrieval, GetRemoteData On Error Resume Next Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP") With Retrieval .Open "Get", s_RemoteFileUrl, False, "", "" .Send GetRemoteData = .ResponseBody End With Set Retrieval = Nothing Set Ads = Server.CreateObject("Adodb.Stream") With Ads .Type = 1 .Open .Write GetRemoteData .SaveToFile Server.MapPath(s_LocalFileName), 2 .Cancel() .Close() End With Set Ads=nothing End Sub '================================================ '作 用:检查组件是否已经安装 '参 数:strClassString ----组件名 '返回值:True ----已经安装 ' False ----没有安装 '================================================ Function eWebEditor_IsObjInstalled(s_ClassString) On Error Resume Next eWebEditor_IsObjInstalled = False Err = 0 Dim xTestObj Set xTestObj = Server.CreateObject(s_ClassString) If 0 = Err Then eWebEditor_IsObjInstalled = True Set xTestObj = Nothing Err = 0 End Function %>